home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / MVCTimeShare.st < prev    next >
Text File  |  1993-07-24  |  7KB  |  212 lines

  1. "    NAME        MVCTimeShare
  2.     AUTHOR        CWatts@BNR.CA (Carl Watts)
  3.     FUNCTION    Stops MVC controllers consuming all the CPU cycles
  4.     ST-VERSION    2.5
  5.     PREREQUISITES    
  6.     CONFLICTS    
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE         3 June 1991
  10. SUMMARY
  11. Change MVC Controllers so that they don't consume
  12. 100% of the CPU when they have control.
  13. "!
  14. "
  15. From: CWatts@BNR.CA (Carl Watts)
  16. Newsgroups: comp.lang.smalltalk
  17. Subject: Making MVC Controllers in Smalltalk-80 v2.5 not consume 100% of the Processor
  18. Message-ID: <1991Jun3.183729.20327@bqnes74.bnr.ca>
  19. Date: Mon, 3 Jun 91 19:37:29 BST
  20. Organization: Bell Northern Research
  21.  
  22. As I promised last week, here is my version of a modification to
  23. Smalltalk-80 v2.5 to change MVC Controllers so that they don't consume
  24. 100% of the CPU when they have control.
  25.  
  26. This is very important if you have applications (like my Finder for
  27. Smalltalk-80) that allow the users to do things by creating a Process
  28. running at userBackgroundPriority (like Finder ST can do to move/copy
  29. large directories in the background while you continue doing other
  30. work in the foreground).
  31.  
  32. Without this modification to MVC Controllers, a Process running at
  33. userBackgroundPriority will almost never get a chance to run.
  34.  
  35. There are several other implementations of ways to accomplish this
  36. goal.  Mine isn't necessarily any better, it just works.  It isn't the
  37. best solution either.  Its just a good, simple solution.
  38.  
  39. Anyway...  Here it is...  The theory is simple.  The InputState
  40. signals a semaphore (called EventSemaphore) whenever a input event
  41. comes in from the virtual machine.  And then appropriate parts of the
  42. Controller mechanism wait on this semaphore in their polling loops.
  43. Simple.
  44. "
  45.  
  46. 'From Objectworks for Smalltalk-80(tm), Version 2.5 of 29 July 1989 on 5 November 1990 at 4:06:17 pm'!
  47.  
  48. 'This fileIn is specifically ordered to fileIn appropriately...'!
  49.  
  50.  
  51. (InputState classVarNames includes: #EventSemaphore)
  52.     ifFalse: [InputState addClassVarName: 'EventSemaphore']!
  53.  
  54.  
  55. !InputState methodsFor: 'initialize-release'!
  56.  
  57. install
  58.  
  59. "Initialize and connect the receiver to the hardware.  Terminate the old input process if any."
  60. "Modified by Carl Watts to initialize the new EventSemaphore as well."
  61.  
  62.     InputProcess == nil ifFalse: [InputProcess terminate].
  63.     self initState.
  64.     EventSemaphore _ Semaphore new.
  65.     InputSemaphore _ Semaphore new.
  66.     IdleSemaphore _ Semaphore new.
  67.     InputProcess _ [IdleSemaphore signal. self run] newProcess.
  68.     InputProcess priority: Processor lowIOPriority.
  69.     InputProcess resume.
  70.     self primInputSemaphore: InputSemaphore! !
  71.  
  72. !InputState methodsFor: 'private'!
  73.  
  74. run
  75.  
  76. "This is the loop that actually processes input events."
  77. "Modified by Carl Watts to nudge the EventSemaphore every time I get some kind of event from the OS."
  78.  
  79.     | word type param |
  80.     [true]
  81.         whileTrue: 
  82.             [InputSemaphore wait.
  83.             "Test for mouse X/Y events here to avoid an activation."
  84.             word _ self primInputWord.
  85.             type _ word bitShift: -12.
  86.             param _ word bitAnd: 4095.
  87. "Mouse X"    type = 1 ifTrue: [self mouseX: param]
  88. "Mouse Y"    ifFalse: [type = 2 ifTrue: [self mouseY: param]
  89. "Key down"    ifFalse: [type = 3 ifTrue: [self keyAt: param put: 1]
  90. "Key up"    ifFalse: [type = 4 ifTrue: [self keyAt: param put: 0]
  91. "MetaInput"ifFalse: [type = 7 ifTrue: [self metaInput: word]
  92. "Delta time"ifFalse: [type = 0 ifTrue: []
  93. "Reset time"ifFalse: [type = 5 ifTrue: [self primInputWord; primInputWord]
  94.             ifFalse: [self error: 'Bad event type']]]]]]].
  95.             self nudge]! !
  96.  
  97. !InputState methodsFor: 'events'!
  98.  
  99. nudge
  100.  
  101. "Something interesting has happened, signal the event semaphore."
  102.  
  103.     EventSemaphore signal!
  104.  
  105. pause
  106.  
  107. "Wait on the Event Semaphore for something interesting to happen."
  108.  
  109.     EventSemaphore wait! !
  110.  
  111.  
  112. !InputSensor methodsFor: 'events'!
  113.  
  114. nudge
  115.  
  116. "Something interesting has happened.  Signal the event semaphore."
  117.  
  118.     CurrentInputState nudge!
  119.  
  120. pause
  121.  
  122. "Wait on the Event Semaphore for something interesting to happen."
  123.  
  124.     CurrentInputState pause! !
  125.  
  126.  
  127. InputSensor install!
  128.  
  129.  
  130. !Controller methodsFor: 'basic control sequence'!
  131.  
  132. controlLoop
  133.  
  134. "Sent by Controller|startUp as part of the standard control sequence.
  135. Controller|controlLoop sends the message Controller|isControlActive to
  136. test for loop termination. As long as true is returned, the loop
  137. continues. When false is returned, the loop ends. Each time through
  138. the loop, the message Controller|controlActivity is sent."
  139.  
  140. "Modified by Carl Watts to pause on the sensor in case nothing
  141. interesting is happening."
  142.  
  143.     [self isControlActive] whileTrue: [
  144.         Processor yield.
  145.         sensor pause.
  146.         self controlActivity].
  147.     sensor nudge! !
  148.  
  149.  
  150. !ControlManager methodsFor: 'scheduling'!
  151.  
  152. searchForActiveController
  153.  
  154. "Find a scheduled controller that wants control and give control to
  155. it.  If none wants control, then see if the System Menu has been
  156. requested."
  157.  
  158. "Modified by Carl Watts so that a scheduled controller does not take
  159. control unless the mouse button is pressed.  This gets rid of the
  160. annoying window flipping to front just because you moved over it.
  161. Also modified to pause on the sensor in case nothing interesting is
  162. happening."
  163.  
  164.     | newController |
  165.  
  166.     (activeControllerProcess == nil or: [activeControllerProcess == Processor activeProcess])
  167.         ifFalse: [^self].
  168.     activeController _ nil.
  169.     Object errorSignal 
  170.         handle: [:ex | "bad controller"
  171.                 ScheduledControllers removeInvalidControllers.
  172.                 ex restart]
  173.         "If the active controller's view is nil, MessageNotUnderstoodSignal 
  174.         is raised and caught as ErrorSignal by the handler."
  175.         do: [[Processor yield.
  176.              screenController sensor pause.
  177.               newController _ (screenController sensor anyButtonPressed)
  178.                 ifTrue: [
  179.                     scheduledControllers
  180.                         detect: [:aController | aController isControlWanted & (aController ~~ screenController)]
  181.                         ifNone:    [screenController isControlWanted
  182.                             ifTrue: [screenController]
  183.                             ifFalse: [nil]]]
  184.                 ifFalse: [nil].
  185.              newController isNil] whileTrue].
  186.     self activeController: newController.
  187.     Processor terminateActive! !
  188.  
  189. !ScrollController methodsFor: 'scrolling'!
  190.  
  191. scroll
  192.  
  193. "Check to see whether the user wishes to jump, scroll up, or scroll down."
  194. "Modified by Carl Watts to pause on the sensor in case nothing interesting is happening."
  195.  
  196.     | savedCursor regionPercent |
  197.     self yellowMenuContainsCursor
  198.                 ifTrue: [^self yellowMenuActivity].
  199.     savedCursor _ sensor currentCursor.
  200.     [self scrollBarOnlyContainsCursor]
  201.         whileTrue: 
  202.             [Processor yield.  sensor pause.
  203.             regionPercent _ 100 * (sensor cursorPoint x - scrollBar left) // scrollBar width.
  204.             regionPercent <= 40
  205.                 ifTrue: [self scrollDown]
  206.                 ifFalse: [regionPercent >= 60
  207.                             ifTrue: [self scrollUp]
  208.                             ifFalse: [self scrollAbsolute]]].
  209.     savedCursor show! !
  210.  
  211.  
  212.